perm filename MSS.F4[MSS,LCS]1 blob
sn#091409 filedate 1974-03-19 generic text, type T, neo UTF8
00100 C ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
00200 C *** READS DATA FROM CLFX, TAIL, FERM, BREP, REST, DRAW1, DRAW2
00300
00400 IMPLICIT INTEGER(A-Q,S-Z)
00500 REAL DIS,PWDS,DISX,A,B,STFF,CENTR,POS
00600 COMMON /DL/X22,SAVER,NAME/RRJJ/RJJ(20)
00700 DIMENSION RPOS(2,40),LST(13),DP(-3/4),LX(14),LY(7),R(8,100)
00800 COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/SIZ/RSZ,JCEN,KCEN
00900 COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
01000 COMMON/ALF/INP(72),ML/XRN/RN(4000)/STF/RSTFAC(8),RSTJC
01100 COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,L,I,IX
01200 COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/POSI/STFF(8),JJB,POS
01300 COMMON/DPY/ST(4000),WDS(250),MEDIT,GO
01400 EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3))
01500 1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JI,JQ(7)),(JJ,JQ(8))
01600 1,(JK,JQ(9)),(JF,JQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2)),(IT,LY(7))
01700 1,(RJC,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(RXGP,WDS(250))
01800 1,(RJK,RJQ(9)),(RJQJ,RJQ(8)),(SET4,RN(3920)),(R,RN(3001))
01900 1 ,(TOP,ST(3999)),(BOT,ST(4000)),(RJH,RJQ(6)),(RJI,RJQ(7))
02000 1,(RPOS(1,1),RN(3921)),(ST2,ST(2)),(IBL,LY(1)),(RJM,RJQ(11))
02100 1,(IE,LX(4)),(IP,LX(10)),(IM,LX(9)),(II,LX(6)),(IS,LX(12))
02200 DATA STFF/-369.0,-246.0,-123.0,0.0,123.0,246.0,369.0,450.0/
02300 1 ,LST/'NOTE','REST','CLEF','LINE','NUMB',
02400 1 'MISC','KSIG','SLUR','BEAM','STAFF','METER','TRILL','WORD'/
02500 1,DP/8*1/,LX/'A','C','D','E','G','I','J','L','M','P','R',
02600 1 'S','U','X'/
02700 1,LY/' ','A','B','D','E','F','T'/
02800
02900 TOP2=-999
03000 RXGP=0
03100 I1=0
03200 C RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
03300 2 CALL DPYSET(1,ST,4000)
03400 CALL TYPLOC(-200,-511)
03500 CALL DPYBRT(5)
03600 RPOS(1,1)=0
03700 PLOTIT=0
03800 RSZ=.845
03900 TOP=-999
04000 BOT=999
04100 JSTF=-1
04200 X22=0
04300 JCEN=0
04400 KCEN=0
04500 PLT=0
04600 PWDS(1)=1.
04700 EDX=-1
04800 SAVER=7
04900 DO 1402 K=1,8
05000 1402 RSTFAC(K)=1.
05100 REDIT=999.
05200 M=1
05300 ITEM=0
05400 ZERO=-1
05500 WDS(1)=4
05600 C DATA IN DPY ARRAY STARTS AT WD.4!
05700 I=1
05800 1100 SCORE=-1
05900 1000 IREADX=0
06000 KNT=0
06100 CALL DPYOUT(1)
06200 IF(SCORE.OR.REND)GO TO 58
06300 C REND=-1 LAST TIME IN SCORE SECTION
06400 CALL SCMSS
06500 I=ISC
06600 ITEM=ISITEM
06700 ST2=WDS(ITEM+1)
06800 CALL ACCPOG(1)
06900 IF(REND.NE.100)GO TO 553
07000 C FOR ESCAPE FROM 'SCORE' SECTION
07100 GO TO 1100
07200 58 GO=-1
07300 GO TO 5505
07400
07500
07600 11 CALL NOTWRT
07700 57 IF(PLT)GO TO 6120
07800 IF(M.LE.I.AND.GO)CALL DPYOUT(1)
07900 IF(JA.EQ.101)GO TO 5531
08000 ITEM=ITEM+1
08100 IF(GO.GT.0)GO TO 20000
08200 K=ST2
08300 IF(X22.EQ.0)GO TO 20000
08400 CALL BOX(IBOX,RBOX,STFF)
08500 ST2=K
08600 20000 WDS(ITEM+1)=ST2
08700 IF(EDX.NE.-1.AND.M.LT.I)GO TO 6120
08800 IF(PLOTIT.EQ.-2)GO TO 2311
08900 C SL=SAVE AFTER RESETTING LENGTH OF PAGE. (SEE I2 IN SCX)
09000 PWDS(ITEM+1)=I
09100 PLT=0
09200 IF(GO.NE.0)GO TO 5531
09300 CALL DPYOUT(1)
09400 GO=-1
09500
09600 5531 IF(IREADX.EQ.-2)GO TO 653
09700 IF(JSTF)GO TO 55
09800 JA=JSTF
09900 JSTF=-1
10000 GO TO 889
10100 C PUT IN A STAFF
10200 55 IF(IREADX.OR.SCORE.EQ.0)GO TO 553
10300 5505 SVST=ST2
10400 C CATCHES TYPO WITH 'C'
10500 K=ITEM+1
10600 IF(X22.EQ.0)GO TO 5503
10700 K=X22
10800 L=RN(MEDIT+1)
10900 IF(L.EQ.16)L=13
11000 IF(L.EQ.18)L=11
11100 IF(L.EQ.30)L=12
11200 IF(L.EQ.11)L=0
11300 C CHANGE CODE NUMS FOR 18 AND 30 ****************
11400 TYPE 427,LST(L),(RN(L),L=MEDIT+1,MEDIT+3)
11500 IF(YED.LT.2)GO TO 5500
11600 C YED IS SET AT 426
11700 5502 DO 5501 L=4,YED+2
11800 5501 TYPE 4271,L,RN(MEDIT+L)
11900 GO TO 5500
12000 891 DEL=0
12100 C THIS NOT USED IF DEL=0 AT LN32510 ***********
12200 GO TO 6531
12300
12400 5503 CALL HYDPOG(3)
12500 C TO DELETE VERTICAL LINE (55)
12600 KED=0
12700 5500 IF(DEL)GO TO 891
12800 IF(IREADX)GO TO 653
12900 5504 IF(I1.EQ.IP)GO TO 2311
13000 59 TYPE 56,NAME,K,SVST
13100 JAB=JA
13200 SCORE=-1
13300 ACCEPT 89,INP
13400 DO 1313 LKX=1,14
13500 1313 IF(I1.EQ.LX(LKX))GO TO 2313
13600 LKX=0
13700 2313 LKX=LKX+1
13800 C 'SA'=SAVE; 'S'=SET; 'SB'=SAVE BIG; 'ST'=STAFF;
13900 IF(X22.NE.0)GO TO(87,884,883,883,5313,87,884,87,883,87,59,883
14000 1,15,883,883),LKX
14100 GO TO(87,13,7555,14,5313,120,884,7555,883,7555,311,883,15,883
14200 1,59),LKX
14300 C A C D E G I J L M P R S U(X
14400 C HERE A=ALTER A GROUP, DE=DELETE A GROUP
14500 C 'DP'=DISPLAY OR HIDE WHICH STAVES. D=DOWN N
14600 14 IF(I2-IE)883,13,884
14700 13 GO=1
14800 CALL GRED
14900 IF(JA.EQ.98)GO TO 5533
15000 KNT=0
15100 SCORE=0
15200 GO TO 65
15300 15 DO 3313 LKY=1,7
15400 3313 IF(I2.EQ.LY(LKY))GO TO(312,3121,3121,3121,312,115,884),LKY
15500 C BL A B D E F T
15600 C 'SF'= SAVE AND FIXUP (I HOPE THIS IS TEMPORARY)
15700 115 CALL FIXUP
15800 GO TO 5505
15900 C RESETS FACTORS FOR SAVE AND REDISPLAY
16000 3121 IF(X22.NE.0)GO TO 5505
16100 SAVER=7
16200 CALL SAVIT
16300 GO TO 5505
16400 312 JA=55
16500 RJB=RN(MEDIT+2)
16600 RJC=55.
16700 GO TO 6531
16800 C ABOVE FOR 'S'ET ALIGNMENT
16900 C 'S'=SET ALIGNMENT, 'A'=ALIGN IT. 'M'=MOVER 'C'= COPIER
17000 C 'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE; 'P' #S = PLOT IT
17100 5313 K=-1
17200 DO 882 JA=3,10
17300 882 IF(INP(JA).NE.IBL)GO TO 884
17400 GO TO 883
17500 885 FORMAT(A2,21F)
17600 884 REREAD 885,K,RJB,RJQ
17700 JA=55
17800 IF(I1.EQ.II)JA=22
17900 IF(I2.EQ.IT)JA=44
18000 IF(I2.NE.'P')GO TO 6531
18100 IF(RJB.GT.5)GO TO 1886
18200 C GO BACK AND RESET ALL
18300 K=RJB
18400 JA=0
18500 C USE '5' FOR STAFF 0.
18600 888 IF(K.EQ.5)K=0
18700 DP(K)=-DP(K)
18800 JA=JA+1
18900 K=RJQ(JA)
19000 IF(K.EQ.0)GO TO 85
19100 C JUMP OUT IF RJQ(JA)=0
19200 GO TO 888
19300 C TO GET BACK ALL LINES TYPE 6+
19400 311 JA=0
19500 ML=0
19600 IF(I2.NE.'X')GO TO 884
19700 1886 DO 2886 K=-3,4
19800 2886 DP(K)=1
19900 IF(I1.NE.IP)GO TO 8851
20000 C PXG OR PXC RESETS 'DP'
20100 C TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
20200 2311 CALL PLTCMD
20300 IF(PLOTIT.EQ.0)GO TO 3005
20400 I1=IP
20500 PLOTIT=-1
20600 GO TO 6531
20700 C 'PXG' OR 'PXC' GOES TO 'PLOT COMMAND' ROUTINE
20800
20900 881 IF(I1.GT.0)GO TO 87
21000 C JUMP IF I1 IS NOT A LETTER (K>0=NUM, K<0=LET.)
21100 883 IF(I2.EQ.IS)GO TO 2
21200 C TYPE 'RS' TO RESTART.
21300 IF(IX.EQ.I.AND.I1.EQ.'C')GO TO 72
21400 CALL EDIT(JJA,RJJB)
21500 GO TO 6531
21600 89 FORMAT(72A1)
21700 C TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
21800
21900 87 REREAD 1,JA,RJB,RJQ
22000 IF(K)JA=55
22100 C ED 47 -1 = 55 47 -1, ETC.
22200 IF(JA.EQ.101)GO TO 11
22300 IF(JA.GT.0)SAVER=SAVER-1
22400 IF(SAVER.AND.X22.EQ.0)CALL SAVIT
22500 C SAVES EVERY 7TH TIME AROUND
22600 IF(JA.EQ.14.OR.JA.EQ.16.OR.JA.EQ.144)GO TO 88
22700 GO TO 6531
22800 188 RJB=0
22900 88 RSTJC=RSTFAC(JC+4)
23000 SET4=RJB
23100 C SET4 IS NEG. FOR AUTOMATIC STAFF 4 SETUP.
23200 IF(JA.NE.14)GO TO 889
23300 C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
23400 SAVER=-1
23500 DO 1889 K=1,I
23600 J=PWDS(K)
23700 IF(RN(J+1).NE.10)GO TO 1889
23800 IF(RN(J+3).EQ.RJC)GO TO 889
23900 1889 CONTINUE
24000 C DIDN'T FIND THIS STAFF
24100 JSTF=JA
24200 JA=10
24300 GO TO 6531
24400 889 SCORE=0
24500 ISC=I
24600 ISITEM=ITEM
24700 C RETAINS ORIGINS OF SCORE SQUENCE
24800 CC DO 9532 K=1,8
24900 DO 9532 L=3001,3800
25000 9532 RN(L)=0
25100 C CLEARS R( , ) ARRAY
25200 REND=0
25300 RSTF=RJC
25400 R(1,1)=JA
25500 R(2,1)=RJB
25600 R(3,1)=RJD
25700 R(4,1)=RJE
25800 R(5,1)=RJF
25900 KNT=0
26000 9533 CALL SCMSS
26100 IREADX=-1
26200 IF(REND)GO TO 653
26300 553 IF(SCORE)GO TO 6531
26400 65 GO=1
26500 C SO DPYOUT COMES ONLY ONE PER LINE.
26600 653 KNT=KNT+1
26700 C NUM OF ITEMS IN LIST
26800 RJK=0
26900 RJQJ=0
27000 RJI=0
27100 JA=R(1,KNT)
27200 RJB=R(2,KNT)
27300 IF(JA.NE.100)GO TO 550
27400 IF(REND.NE.1.)GO TO 1000
27500 C =1 GOES BACK FOR MORE
27600 KNT=0
27700 IF(RJB.LT.0)GO TO 188
27800 C WILL READ ANOTHER STAFF
27900 GO TO 1100
28000 C 100 STOPS READER.
28100 550 DO 7531 K=1,6
28200 7531 RJQ(K)=R(K+2,KNT)
28300 IF(RJG.EQ.1.9)RJQJ=1
28400 C FOR GRACE NOTE SLASH
28500 CC RJI=AMOD(RJC,1.)
28600 IF(JA.EQ.9)GO TO 16
28700 IF(JA.NE.999)GO TO 6531
28800 C 999 MEANS P9 AND P10 ARE USED WITH BEAMS
28900 JA=9
29000 RJQ(8)=R(3,KNT)
29100 RJI=R(2,KNT)
29200 RJB=RJJB
29300 RJC=RJJ(1)
29400 16 RJK=-1
29500 6531 M=1
29600 EDX=-1
29700 IF(JA.EQ.222)GO TO 72
29800 IF(JA.EQ.2222)GO TO 73
29900 DO 5532 K=1,10
30000 5532 JQ(K)=RJQ(K)
30100 IF(JA.NE.99.AND.JA.NE.98)GO TO 7542
30200 CALL DELETE
30300 IF(JA.EQ.99)GO TO 425
30400 5533 X22=0
30500 GO=-1
30600 CALL DPYNEW
30700 GO TO 55
30800
30900 590 IF(PLOTIT.EQ.-1)GO TO 121
31000 I1=0
31100 GO TO 243
31200 C GOES TO PLOTTER
31300 7542 IF(I1.EQ.'P')GO TO 590
31400 C X22= ITEM# WHEN EDITING OR DELETING.
31500 IF(X22.NE.0)GO TO 5511
31600 IF(JA.GT.0)GO TO 155
31700 IF(RJB.NE.0)GO TO 6221
31800 C FOR UP, DOWN, LEFT, RIGHT
31900 GO TO 5505
32000 C GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
32100 155 IF(JA.EQ.24)GO TO 24
32200 IF(JA.EQ.22)GO TO 42
32300 IF(JA.EQ.44)GO TO 44
32400 IF(JA.EQ.55)GO TO 554
32500 IF(JA.EQ.333)GO TO 6333
32600 IF(IABS(JC).GT.5.OR.(IABS(JD).GT.50.AND.JA.GT.4.AND.
32700 1 JA.NE.9.AND.JA.NE.10))GO TO 5505
32800 C CATCHES SOME TYPO ERRORS IN P3 AND P4.
32900 C AVOIDS EXIT AFTER TYPO ERROR
33000 IF(JA.EQ.21.OR.JA.EQ.19)GO TO 61
33100 GO TO 60
33200
33300 33 JB=RJB
33400 RJB=RJJ(JB-2)
33500 IF(JB.EQ.2)RJB=RJJB
33600 TYPE 1,JB,RJB
33700 C TYPE 33,N TO SEE FULL CONTENTS OF PARAM. N.
33800 GO TO 5505
33900
34000 24 GO=0
34100 IF(ABS(RJB).GT.99)GO TO 5505
34200 IF(RJB.NE.0)GO TO 241
34300 GO=-1
34400 243 RJB=1.
34500 C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
34600 241 RSZ=.845*RJB
34700 JCEN=RJC*RSZ
34800 KCEN=RJD*RSZ
34900 RJB=0
35000 RJC=0
35100 RJD=0
35200 TOP=-999
35300 BOT=999
35400 85 M=1
35500 I=PWDS(ITEM+1)
35600 ITEM=0
35700 8552 ST2=3
35800 8852 PLT=1
35900 EDX=0
36000 CALL ACCPOG(1)
36100 IF(JA.NE.24)GO=0
36200 GO TO 6120
36300
36400 6333 CALL LISTP(LST)
36500 GO TO 5505
36600
36700 172 CALL JUGGLE
36800 272 CALL DPYNEW
36900 IF(JA.EQ.22)GO TO 424
37000 C FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
37100 IF(ZERO)GO TO 55
37200 X22=ZERO
37300 ZERO=-1
37400 IF(JA.EQ.55)GO TO 554
37500 IF(JA.EQ.44)GO TO 44
37600 IF(KED.NE.0)GO TO 244
37700 GO TO 425
37800
37900 C 55,POS -- SETS UP ALIGNMENT
38000 554 CALL BOX(-1,RJB,STFF)
38100 IF(JD.EQ.0)KED=-1
38200 RITEM=RJD
38300 C FOR 'ED POS., STF., CODE#'
38400 IF(JC.GT.4)KED=-2
38500 RLINE=RJB
38600 RJB=RJC
38700 GO TO 45
38800
38900 C '22,0' EDITS LAST ITEM ENTERED
38950 42 REDIT=999.0
39000 IF(RJB.NE.0)GO TO 242
39100 X22=ITEM
39200 GO TO 429
39300 44 KED=1
39400 RITEM=RJC
39500 C 'ST', STF#, CODE# (IF 0, ALL ITEMS COME UP)
39600 45 REDIT=RJB
39700 C THE STAFF #
39800 JED=1
39900 244 X=ITEM
40000 IF(JED.GT.X)GO TO 444
40100 DO 144 K=JED,X
40200 L=PWDS(K)
40300 IF(KED.EQ.-2)GO TO 654
40400 C -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
40500 IF(RN(L+3).NE.REDIT)GO TO 144
40600 IF(KED)GO TO 654
40700 IF(RITEM.NE.0.AND.RITEM.NE.RN(L+1))GO TO 144
40800 IF(JA.NE.55)GO TO 344
40900 654 IF(ABS(RLINE-RN(L+2)).LT.5.0)GO TO 344
41000 144 CONTINUE
41100 444 REDIT=999.
41200 C NO MORE ON LINE
41300 RJB=0
41400 C SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
41500 GO TO 73
41600 344 JED=K+1
41700 C FOR NEXT TIME AROUND
41800 X22=K
41900 GO TO 429
42000 C CR MOVES ALONG GIVEN LINE, 222 LEAVES THIS MODE
42100
42200 91 CALL ACCPOG(1)
42300 IF(I.EQ.IX)ITEM=ITEM-1
42400 GO TO 142
42500 242 IF(X22.GT.0)GO TO 5511
42600 142 IF(RJB.NE.0)GO TO 424
42700 IF(REDIT.NE.999..AND.JA.GE.0)GO TO 244
42800 X22=X22+1
42900 IF(JA)X22=X22-1+JA
43000 IF(X22.LT.1)X22=1
43100 GO TO 425
43200 424 X22=RJB
43300 425 IF(X22.GT.ITEM)GO TO 73
43400 C LEAVES EDIT MODE.
43500 429 IX=I
43600 MEDIT=PWDS(X22)
43700 J=2
43800 426 Y=RN(MEDIT)+J
43900 CALL LOOP(0,Y,1,I,MEDIT,RN)
44000 JJA=RN(I+1)
44100 YED=Y-2
44200 L=I+2
44300 DO 422 K=1,11
44400 IF(K.GT.YED)GO TO 423
44500 RJJ(K)=RN(L+K)
44600 GO TO 422
44700 423 RJJ(K)=0
44800 422 CONTINUE
44900 RJJB=RN(L)
45000 IF(GO.GT.0)GO TO 4231
45100 C NO BOX WHEN IN GROUP EDIT ROUTINE
45200 IBOX=I
45300 RBOX=RJJ(1)
45400 CALL BOX(IBOX,RBOX,STFF)
45500 4231 ITEM=ITEM+1
45600 ST2=WDS(ITEM)
45700 GO TO 55
45800 427 FORMAT(1XA5/,F4.0,F7.2,F6.2,$)
45900 4271 FORMAT('+ (',I2,')',F7.2,$)
46000
46100 C FOR EDITING
46200 5511 IF(JA.EQ.55)GO TO 420
46300 220 IF(JA.NE.22)GO TO 720
46400 C 'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
46500 KED=0
46600 JED=0
46700 GO TO 72
46800 720 IF(JA.EQ.44)GO TO 420
46900 IF(JA.EQ.33)GO TO 33
47000 IF(JA.GT.13.OR.JA.EQ.1)GO TO 5505
47100 C PARAM NUM TOO HIGH?
47200 C LOOKS FOR NEXT ITEM TO EDIT IF <CR>
47300 4221 IF(X22.EQ.0.OR.RJB.NE.0)GO TO 5517
47400 C BACKS UP WHEN IN EDIT MODE.
47500
47600 IF(JA.GT.0)GO TO 5518
47700 IF(I.EQ.IX)GO TO 91
47800 ZERO=X22+1
47900 C '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
48000 72 IF(X22.EQ.0)GO TO 55
48100 IF(KED.EQ.0)REDIT=999.
48200 320 IF(I.NE.IX)GO TO 172
48300 ITEM=ITEM-1
48400 C TO DELETE AN ITEM
48500 73 X22=0
48600 CALL DPYNEW
48700 IF(REDIT.EQ.999.)GO TO 441
48800 IF(JA.EQ.55)GO TO 554
48900 IF(JA.EQ.44)GO TO 44
49000 441 IF(RJB.EQ.0.OR.RJB.GT.ITEM)GO TO 55
49100 GO TO 424
49200 C DELETION IN EDIT MODE DOES NOT LEAVE MODE.
49300
49400 5517 IF(JA.EQ.0)GO TO 6221
49500 5518 IF(JA.EQ.2)GO TO 7221
49600 IF(JA.GE.22)GO TO 55
49700 RJJ(JA-2)=RJB
49800 RJB=RJJB
49900 GO TO 6222
50000
50100 7555 CALL MOVER
50200 IF(RJC.EQ.99)GO TO 5504
50300 C 99=BACKUP OUT OF MOVER ETC.
50400 8853 IF(JJB)GO TO 57
50500 M=PWDS(JJB)
50600 I=PWDS(ITEM+1)
50700 ITEM=JJB-1
50800 ST2=WDS(JJB)
50900 C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
51000 GO TO 8852
51100
51200 8851 IF(I1.NE.IP)GO TO 85
51300 GO TO 6531
51400
51500 420 REDIT=0
51600 211 IF(RJB.NE.0)GO TO 320
51700 IF(KED.GE.0)RLINE=RJJB
51800 RJB=RLINE
51900 C FOR '55' ALIGNING
52000 7221 RJJB=RJB
52100 6222 IF(JQ(1).EQ.0)GO TO 6221
52200 C ARRAYS NEED 2O LOCATIONS HERE.
52300 C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122 4,13 5,-2 ETC.)
52400 DO 1222 K=1,20,2
52500 L=JQ(K)
52600 IF(L-2)6221,2222,3222
52700 3222 RJJ(L-2)=RJQ(K+1)
52800 GO TO 1222
52900 2222 RJJB=RJQ(K+1)
53000 RJB=RJJB
53100 1222 CONTINUE
53200 C*** LOOP SET TO 10 (20 IN ARRAY!)
53300 6221 DO 5514 K=1,11
53400 RJQ(K)=RJJ(K)
53500 5514 JQ(K)=RJQ(K)
53600 JA=JJA
53700 ITEM=ITEM-1
53800 IF(ITEM)ITEM=0
53900 ST2=WDS(ITEM+1)
54000 I=PWDS(ITEM+1)
54100 CALL DPYNEW
54200
54300 60 IF(DP(JC))GO TO 57
54400 RSTJC=RSTFAC(JC+4)
54500 RD=0
54600 IF(JA.EQ.50)JA=16
54700 C ABOVE SHOULD BE TAKEN OUT AT SOME FUTURE DATE. (12/73)
54800 IF(RJB.LT.1000)GO TO 66
54900 RD=RJB
55000 IF(JA.EQ.8)RJM=RJB/1000.
55100 CALL RNOTE(RJB)
55200 C IF RJB>1000 IT FINDS TRUE RJB THROUGH NOTE NUMB.
55300 66 IF(EDX.EQ.0.OR.I1.EQ.IP)GO TO 5541
55400 RJJB=RJB
55500 JJA=JA
55600 IF(JA.NE.16.OR.RJI.EQ.0)GO TO 160
55700 CC360 RJI=0
55800 RJB=RN(IFIX(PWDS(X22-1))+2)+39.6*RSTJC*RJE
55900 C PUTS 13TH(+) LETTER TIN RIGHT POS. AFTER HORIZ. MOVE.
56000 160 IF(JA.EQ.1.AND.RJH.EQ.0)RJH=999.
56100 C 999=0 FOR STEM EXTENSIONS.
56200 CNT=1
56300 DO 5543 K=1,9
56400 C 10/6/73 ABOVE WAS ,11
56500 RA=RJQ(K)
56600 IF(RA.NE.0)CNT=K
56700 5543 RJJ(K)=RA
56800 C USES ONLY 10 PARAMETERS BEYOND JA, JB
56900 2554 IF(PLT.NE.0)GO TO 5541
57000 IF(JA.EQ.9)CALL HOMER
57100 IF(JA.NE.6)GO TO 1261
57200 IF(JF.NE.0)RJM=-1
57300
57400 1261 IF(RJM.NE.0)CALL HOMER
57500 C IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
57600 C **** FOR '0' EDITS ******
57700 261 RN(I)=CNT
57800 RN(I+1)=JA
57900 I=I+2
58000 RN(I)=RJB
58100 IF(RD.NE.0)RN(I)=RD
58200 C TO SAVE NOTE NUMBS IN P2.
58300 DO 4554 K=1,CNT
58400 4554 RN(I+K)=RJQ(K)
58500 3554 I=CNT+1+I
58600 C WHAT ABOUT EDITS?*******
58700 5541 POS=STFF(JC+4)
58800 JB=RHORZ(RJB)
58900 C LINE IS DIVIDED INTO 200 POINTS.
59000 CENTR=POS
59100 551 IF(JA.EQ.4.OR.JA.EQ.10)GO TO 25
59200 IF(JA.EQ.7)GO TO 81
59300 IF(JA.LE.12.OR.JA.EQ.30)GO TO 11
59400 IF(JA.EQ.18)GO TO 80
59500 IF(JA.NE.88)GO TO 116
59600 IF(RJB.EQ.0)RJB=1
59700 C USE ONLY ONE 88 CHANGE PER STAFF!!!! ********
59800 RSTFAC(JC+4)=RJB
59900 C 88,FAC,STF SETS STAFF SIZE FACTOR(ALSO CAN BE DONE WITH 10)
60000 GO TO 57
60100 116 IF(JA.NE.16.AND.JA.NE.20)GO TO 120
60200 CALL ALPHA
60300 GO TO 57
60400
60500 81 CALL KSIG
60600 GO TO 57
60700
60800 80 CALL METER
60900 GO TO 57
61000
61100 61 CALL HOMER
61200 GO TO 8853
61300
61400 25 CALL ITMSUB
61500 C BAR LINES, BEAMS, STAFF LINES ****
61600 GO TO 57
61700
61800 C TO GET DISPLAY: 'G'; 'GM' ADDS TO DPY;
61900 120 IF(I.NE.1.AND.I2.NE.IM)GO TO 5505
62000 C 'GM'=GET MORE
62100 TYPE 21
62200 ACCEPT FA5,NAME
62300 IF(NAME.EQ.'99')GO TO 5505
62400 IF(NAME.NE.IBL.AND.LOOKD(NAME).EQ.0)GO TO 120
62500 C FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
62600 3005 REWIND 21
62700 C GUARDS AGAINST LOSSAGE!
62800 PLOTIT=-1
62900 IF(I1.NE.'G')PLOTIT=-2
63000 2005 IF(NAME.EQ.IBL)GO TO 2200
63100 CALL IFILE(21,NAME)
63200 C JUMP TO READ BIG FILES
63300 2200 J=ITEM+1
63400 2202 READ(21,END=2207),X,Y,
63500 1 (PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2),ISCR,(V(K),K=1,ISCR),
63600 1 LCNT,(LIST(K),K=1,LCNT)
63700 CC PUT IN NEXT YEAR(12/73)1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF
63800 2207 IF(Y.EQ.0)GO TO 2205
63900 ITEM=ITEM+X
64000 IF(I2.EQ.IM)GO TO 2203
64100 I=Y
64200 READ(21,END=8851),RSTFAC,STFF
64300 IF(I1.EQ.IP)GO TO 6531
64400 READ(21,END=8851),ST2,(ST(K),K=1,ST2+2),(WDS(K),K=1,ITEM+1)
64500 CALL DPYNEW
64600 GO TO 5505
64700 2205 TYPE 2206
64800 CALL EXIT
64900 2206 FORMAT(' **** UNPACK IT! ****')
65000
65100 2203 RA=I-1
65200 DO 2204 K=J,J+X
65300 2204 PWDS(K)=PWDS(K)+RA
65400 GO TO 85
65500 121 IF(PLOTIT.EQ.0)GO TO 5504
65600 5121 CALL PLTSRT
65700 C IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
65800 PLT=-1-JH
65900 C (JH) P8=1 OR 2 FOR 2-PASS PLOTS
66000 M=I
66100 I=I+M-1
66200 IF(RJB.EQ.0)RJB=1.
66300 DIS=RJB*1.24
66400 IF(RJC.EQ.0)RJC=RJB
66500 RHT=RJC*1.2
66600 C 1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
66700 BOT=-BOT*RHT
66800 IF(TOP2.EQ.-999)GO TO 8121
66900 BOT=BOT+TOP2
67000 GO TO 9121
67100 8121 CALL PLOTS(K)
67200 RXGP=995.-BOT
67300 9121 NOMOVE=RJF+RJG*148.*RJC
67400 C RJF=1 FOR NO MOVE AT END. RJG=# OF STAVES TO MOVE FOR NEW STAFF 0.
67500 IXGP=JD
67600 C (JD) P4=1 FOR XGP OUTPUT
67700 IF(JE.NE.0)GO TO 1122
67800 IF(RJD.EQ.0)GO TO 6121
67900 IF(TOP2.NE.-999)RXGP=RXGP-BOT
68000 C MOVES 0 POINT OVER EACH TIME.
68100 GO TO 1122
68200 6121 CALL PLOT(0,BOT,-3)
68300 C MOVES PLOTTER UP IF P5=0.
68400 1122 X22=IXGP
68500
68600 C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
68700 6120 IF(M.GE.I)GO TO 7120
68800 CNT=RN(M)
68900 C CLEARS INPUT ARRAY, USES ONLY 12 PARAMS.
69000 DO 6220 K=CNT+1,10
69100 JQ(K)=0
69200 6220 RJQ(K)=0
69300 JA=RN(M+1)
69400 M=M+2
69500 RJB=RN(M)
69600 DO 9120 K=1,CNT
69700 RJQ(K)=RN(M+K)
69800 9120 JQ(K)=RJQ(K)
69900 M=CNT+M+1
70000 IF(EDX.LE.0)GO TO 60
70100 GO TO 5505
70200
70300 7120 M=1
70400 IF(EDX)GO TO 71201
70500 IF(PLT.EQ.1)EDX=-1
70600 PLT=0
70700 C RETURNS FOR 'SL'=SAVE LAST
70800 GO TO 5505
70900 71201 X=50*RHT
71000 TOP=TOP*RHT+X
71100 IF(NOMOVE.NE.0)TOP=0
71200 IF(NOMOVE.GT.1)TOP=NOMOVE
71300 IF(IXGP.EQ.0)CALL PLOT(0,TOP,3)
71400 TOP2=TOP
71500 GO TO 2
71600 C TO MOVE 'PLOTTER' FOR XGP OUTPUT
71700 CC7121 CALL PLOT(0,TOP,3)
71800 C MOVES PLOTTER UP
71900 C ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
72000 CC TOP2=TOP
72100 CC GO TO 2
72200
72300 56 FORMAT(/1XA5,' TYPE FOR ITEM #',I3,I/)
72400 1 FORMAT(I,24F)
72500 21 FORMAT(' FILE NAME? '$)
72600 END